home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / msortp.zip / TMSORTP.PAS < prev   
Pascal/Delphi Source File  |  1993-02-02  |  8KB  |  287 lines
  1. {===================================================================
  2.  TMSORTP - a test program for the MSORTP unit
  3.  
  4.  Call with 5 command line parameters as follows:
  5.  
  6.    TMSORTP ElsToSort MemToUse MinSize MaxSize SizeStep
  7.  
  8.  where
  9.    ElsToSort   is the number of elements to sort
  10.    MemToUse    is the maximum bytes of heap space for the sort to use
  11.    MinSize     is the smallest element size to test in bytes
  12.    MaxSize     is the largest element size to test
  13.    SizeStep    is the number of bytes to step between tests
  14.  
  15.  The smallest acceptable value for MinSize is 4. The largest
  16.  acceptable value for MaxSize is 40000. (This can be increased for
  17.  DPMI and real mode apps, where the stack and global data don't share
  18.  the same data.)
  19.  
  20.  TMSORTP reports the most interesting results from the MergeInfo
  21.  procedure -- number of merge files, number of merge phases, peak disk
  22.  space, actual amount of heap used -- as well as the results of the
  23.  OptimumHeapToUse and MinimumHeapToUse functions. Then it performs the
  24.  sort.
  25.  
  26.  TMSORTP sorts records that start with a 4-byte LongInt key, followed
  27.  by a zero-filled variable length array to make up the rest of the
  28.  record.
  29.  
  30.  If the Time symbol is defined below, and the OPTIMER unit is
  31.  available (from the OPRO bonus disk, from CompuServe, or from the
  32.  TurboPower BBS), and the program is being run from DPMI or real mode
  33.  DOS (as opposed to Windows), TMSORTP times the sort and reports the
  34.  time in milliseconds.
  35.  
  36.  If TestAccuracy is defined below, TMSORTP checks the results of the
  37.  sort for accuracy. It assures that each sorted element is greater
  38.  than or equal to the previous element, that the correct number of
  39.  sorted elements is returned, that the checksum of the sorted elements
  40.  is the same as the checksum of the original elements, and that the
  41.  tail of each sorted record contains correct data.
  42.  
  43.  If Sequential is defined below, the LongInt keys are created in
  44.  sequential order, with the result that the sort engine is sorting an
  45.  already sorted group of records. (This is actually a worst-case for a
  46.  plain quick sort algorithm, although MSORTP takes measures to defeat
  47.  this worst case). If Sequential is not defined, the LongInt keys are
  48.  a random sequence generated by Turbo Pascal's Random function.
  49.  
  50.  See MSORTP.DOC for more information about using the MSORTP unit.
  51.  ===================================================================}
  52.  
  53. {$IFNDEF Windows}
  54.   {$DEFINE Time}        {Define to time the sorts}
  55. {$ENDIF}
  56. {$DEFINE TestAccuracy}  {Define to test the accuracy of the sorts}
  57. {.$DEFINE Sequential}   {Define to test sort of a sorted list}
  58.  
  59. {$R-,S-,X+}
  60. program TMSortP;
  61.   {-Test/demo program for MSORTP unit}
  62. uses
  63.   {$IFDEF Windows}
  64.   WinCrt,
  65.   {$ELSE}
  66.   Crt,
  67.   {$ENDIF}
  68.   {$IFDEF Time}
  69.   OpTimer,
  70.   {$ENDIF}
  71.   MSortP;
  72.  
  73. const
  74.   AbsMaxElSize = 40000;  {Largest element we can test}
  75. type
  76.   ElementType =
  77.     record
  78.       case Byte of
  79.         0 : (Key : LongInt);
  80.         1 : (Data : array[1..AbsMaxElSize] of Byte);
  81.     end;
  82. var
  83.   ElsToSort : LongInt;
  84.   MemToUse : LongInt;
  85.   MinElSize : Word;
  86.   MaxElSize : Word;
  87.   ElSizeStep : Word;
  88.   ElSize : Word;
  89.   Status : Word;
  90.   CmpStatus : Word;
  91.   BytesAtEnd : Word;
  92.   MI : MergeInfoRec;
  93.   {$IFDEF Time}
  94.   T1 : LongInt;
  95.   T2 : LongInt;
  96.   {$ENDIF}
  97.   DataRec : ElementType;
  98.   {$IFDEF TestAccuracy}
  99.   CheckSum : LongInt;
  100.   {$ENDIF}
  101.  
  102. procedure SendToSortEngine; far;
  103. var
  104.   I : LongInt;
  105. begin
  106.   FillChar(DataRec, SizeOf(ElementType), 0);
  107.   {$IFDEF Time}
  108.   T1 := ReadTimer;
  109.   {$ENDIF}
  110.   {$IFDEF TestAccuracy}
  111.   CheckSum := 0;
  112.   {$ENDIF}
  113.   for I := 1 to ElsToSort do begin
  114.     {$IFDEF Sequential}
  115.     DataRec.Key := I;
  116.     {$ELSE}
  117.     DataRec.Key := LongInt(Random(32767))*Random(32767);
  118.     {$ENDIF}
  119.     {$IFDEF TestAccuracy}
  120.     move(DataRec.Key, DataRec.Data[ElSize-BytesAtEnd+1], BytesAtEnd);
  121.     inc(CheckSum, DataRec.Key);
  122.     {$ENDIF}
  123.     if not PutElement(DataRec) then
  124.       Exit;
  125.   end;
  126. end;
  127.  
  128. procedure GetFromSortEngine; far;
  129. var
  130.   Count : LongInt;
  131.   Last : LongInt;
  132.   EndCheck : LongInt;
  133.   StartCheck : LongInt;
  134.   TestSum : LongInt;
  135. begin
  136.   Count := 0;
  137.   Last := -1;
  138.   {$IFDEF TestAccuracy}
  139.   TestSum := 0;
  140.   {$ENDIF}
  141.   while GetElement(DataRec) do begin
  142.     {$IFDEF TestAccuracy}
  143.     inc(Count);
  144.     {$IFDEF Sequential}
  145.     if DataRec.Key <> Count then begin
  146.       WriteLn;
  147.       WriteLn('Sort error!!! Count:', Count, '  Data:', DataRec.Key);
  148.       CmpStatus := 9999;
  149.       Exit;
  150.     end;
  151.     {$ELSE}
  152.     if DataRec.Key < Last then begin
  153.       WriteLn;
  154.       WriteLn('Sort error!!! Count:', Count, '  Data:', DataRec.Key, '  Last:', Last);
  155.       CmpStatus := 9999;
  156.       Exit;
  157.     end;
  158.     Last := DataRec.Key;
  159.     {$ENDIF}
  160.     StartCheck := 0;
  161.     move(DataRec.Key, StartCheck, BytesAtEnd);
  162.     EndCheck := 0;
  163.     move(DataRec.Data[ElSize-BytesAtEnd+1], EndCheck, BytesAtEnd);
  164.     if EndCheck <> StartCheck then begin
  165.       WriteLn;
  166.       WriteLn('Storage error!!! Count:', Count);
  167.       CmpStatus := 9998;
  168.       Exit;
  169.     end;
  170.     inc(TestSum, DataRec.Key);
  171.     {$ENDIF}
  172.   end;
  173.   {$IFDEF TestAccuracy}
  174.   if Count <> ElsToSort then begin
  175.     WriteLn;
  176.     WriteLn('Count error!!!');
  177.     CmpStatus := 9997;
  178.   end;
  179.   if TestSum <> CheckSum then begin
  180.     WriteLn;
  181.     WriteLn('Checksum error!!!');
  182.     CmpStatus := 9997;
  183.   end;
  184.   {$ENDIF}
  185.   {$IFDEF Time}
  186.   T2 := ReadTimer;
  187.   {$ENDIF}
  188. end;
  189.  
  190. function CompareElements(var X, Y) : Boolean; far;
  191. begin
  192.   CompareElements := (ElementType(X).Key < ElementType(Y).Key);
  193. end;
  194.  
  195. function GetLong(OptName, S : String; Min, Max : LongInt) : LongInt;
  196. var
  197.   L : LongInt;
  198.   Code : Word;
  199. begin
  200.   Val(S, L, Code);
  201.   if Code <> 0 then begin
  202.     WriteLn(OptName, ' invalid: "', S, '"');
  203.     Halt;
  204.   end;
  205.   if (L < Min) or (L > Max) then begin
  206.     WriteLn(OptName, ' out of range ', Min, '..', Max, ': "', S, '"');
  207.     Halt;
  208.   end;
  209.   GetLong := L;
  210. end;
  211.  
  212. begin
  213.   if ParamCount <> 5 then begin
  214.     WriteLn('Usage: TMSORTP ElsToSort MemToUse MinSize MaxSize SizeStep');
  215.     Halt;
  216.   end;
  217.   ElsToSort := GetLong('ElsToSort', ParamStr(1), 2, MaxLongInt);
  218.   MemToUse := GetLong('MemToUse', ParamStr(2), 1, MaxLongInt);
  219.   MinElSize := GetLong('MinSize', ParamStr(3), 4, AbsMaxElSize);
  220.   MaxElSize := GetLong('MaxSize', ParamStr(4), 4, AbsMaxElSize);
  221.   ElSizeStep := GetLong('SizeStep', ParamStr(5), 1, AbsMaxElSize);
  222.  
  223.   {$IFNDEF Windows}
  224.   Assign(Output, '');
  225.   Rewrite(Output);
  226.   {$ENDIF}
  227.  
  228.   WriteLn('ElsToSort    ', ElsToSort);
  229.   WriteLn('MemToUse     ', MemToUse);
  230.   WriteLn;
  231.         {ssssss  ffff  ppppp  ddddddd  hhhhhhh  ooooooo  mmmmmmm  tttttt}
  232.   Write('ElSize Files Phases     Disk     Heap  OptHeap  MinHeap');
  233.   {$IFDEF Time}
  234.   Write('    Time');
  235.   {$ENDIF}
  236.   WriteLn;
  237.  
  238.   ElSize := MinElSize;
  239.   while ElSize <= MaxElSize do begin
  240.     MergeInfo(MemToUse, ElSize, ElsToSort, MI);
  241.     Write(ElSize:6, '  ',
  242.           MI.MergeFiles:4, '  ',
  243.           MI.MergePhases:5, '  ',
  244.           MI.MaxDiskSpace:7, '  ',
  245.           MI.HeapUsed:7, '  ',
  246.           OptimumHeapToUse(ElSize, ElsToSort):7, '  ',
  247.           MinimumHeapToUse(ElSize):7, '  ');
  248.     if MI.SortStatus <> 0 then begin
  249.       WriteLn('Status = ', MI.SortStatus);
  250.       Halt;
  251.     end;
  252.  
  253.     RandSeed := 0;
  254.     CmpStatus := 0;
  255.  
  256.     {$IFDEF TestAccuracy}
  257.     BytesAtEnd := ElSize-4;
  258.     if BytesAtEnd > 4 then
  259.       BytesAtEnd := 4;
  260.     {$ENDIF}
  261.  
  262.     Status := MergeSort(MemToUse, ElSize,
  263.                         SendToSortEngine,
  264.                         CompareElements,
  265.                         GetFromSortEngine,
  266.                         DefaultMergeName);
  267.     if CmpStatus <> 0 then begin
  268.       WriteLn('  Bug ', CmpStatus);
  269.       Halt;
  270.     end;
  271.     if Status <> 0 then begin
  272.       WriteLn('  Failure ', Status);
  273.       Halt;
  274.     end;
  275.     {$IFDEF Time}
  276.     Write(ElapsedTime(T1, T2):6:0);
  277.     {$ENDIF}
  278.     WriteLn;
  279.     if KeyPressed then begin
  280.       ReadKey;
  281.       Halt;
  282.     end;
  283.  
  284.     inc(ElSize, ElSizeStep);
  285.   end;
  286. end.
  287.